perm filename VARBL.SAI[PUB,TES]2 blob sn#150112 filedate 1975-03-12 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGOF("VARBL")
C00003 00003	PUBLIC SIMPLE PROCEDURE VARBL! $"#
C00006 00004	PUBLIC SIMPLE PROCEDURE VARASSIGN(STRING NAME, VAL) $"#
C00007 00005	PUBLIC RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT $"#
C00008 00006	PUBLIC SIMPLE PROCEDURE DVARIABLE $"#
C00009 00007	PUBLIC STRING SIMPLE PROCEDURE EVALV(STRING THISWD  INTEGER IX, TYP) $"#
C00016 00008	PUBLIC STRING SIMPLE PROCEDURE VASSIGN(INTEGER VSYMB, VTYPE, VIX STRING VAL) $"#
C00023 00009	PUBLIC STRING SIMPLE PROCEDURE VEVAL $"#
C00024 00010	FINISHED
C00025 ENDMK
C⊗;
BEGOF("VARBL")

COMMENT

                *** Variations at Different Sites ***

The variable FULLFILE is computed differently at TENEX sites.

                                 ***

Variable assignment and evaluation.

;

PROCEDURES
PUBLIC SIMPLE PROCEDURE VARBL! ;$"#
BEGIN "VARBL!"
INTEGER J, K ;
STRING S ;
J ← -1 ;
RKJ: 6-FEB-75 ADD "AUTOCRLF" WHICH CONTROLS GENERATED
		CRLF ON TTY← AND ←TTY, DEFAULT IS TRUE;
RKJ: 6-Feb-75 also "CHARH" read only in bits (1 for LPT) ;
comment Internal Variables;
FOR S ← "LINES", "COLUMNS", "!", "SPREAD", "FILLING",
	"!SKIP!", "!SKIPL!", "!SKIPR!",
	"NULL", "!INF", "FOOTSEP", "TRUE", "FALSE",
	"INDENT1", "INDENT2", "INDENT3", "LMARG", "RMARG",
	"CHAR", "CHARS", "LINE", "COLUMN", "TOPLINE", "XCRIBL", "CHARW",
	"XGENLINES", "UNDERLINE", "THISDEVICE", "THISFONT",
	"FOOTGAP", "FOOTSEPFONT", "TTY", "ODDLEFTBORDER", "EVENLEFTBORDER",
	"FULLFILE", "THISLINE", "MAXTEMPLATE", "ERRLF", "DEBUGFLAG",
	"VBPI", "HBPI", "!XGPLFTMAR", "MINCHARW",
	"FOOTGAP2", "MILLSPACING", "MILLPREFACE", "LINEPREFACE", "LINESPACING",
	"!XGPINTRA", "TOPBORDER", "BOTTOMBORDER",
	"AUTOCRLF", "CHARH"  DO
		BIND(DECLARE(SYMNUM(S), INTERNTYPE), J←J+1) ;
comment Global Variables with Preset values ;
VARASSIGN("FILE", IFILENAME) ;
K ← CALL(0, "DATE") ;
VARASSIGN("MONTH", (STR1 ← MONTH[K DIV 31 MOD 12 + 1])[1 TO ∞-1]) ;
VARASSIGN("DAY", STR2 ← CVS(K MOD 31 + 1)) ;
VARASSIGN("YEAR", STR3 ← CVS(K DIV 31 DIV 12 + 1964)) ;
VARASSIGN("DATE", STR1 & STR2 & ", " & STR3 );
K ← CALL(0,"TIMER")/3600 ; S ← CVS(K MOD 60) ; IF LENGTH(S)=1 THEN S ← "0"&S ;
VARASSIGN("TIME", CVS(K DIV 60) & ":" & S) ;
AUTOCRLF←TRUE ;  RKJ: 6-Feb-75 ;
END "VARBL!" ;
PUBLIC SIMPLE PROCEDURE VARASSIGN(STRING NAME, VAL) ;$"#
	VASSIGN(SIMNUM(NAME), 0, SYMIX, VAL) ;
PUBLIC RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT ;$"#
IF NEXTSCH(←) THEN
	BEGIN
	VASSIGN(SYMB, THISTYPE, IX, E(SPASS(PASS), 0)) ;
	IF ITSCH(;) THEN PASS ;  RETURN(TRUE) ;
	END
ELSE RETURN(FALSE) ;
PUBLIC SIMPLE PROCEDURE DVARIABLE ;$"#
DO	BEGIN
	DPASS ;
	IF THISISID THEN
		BEGIN
		IF ON THEN
		    BIND(SYMB←DECLARE(SYMB, LOCALTYPE), IX←PUSHS(1,NULL)) ;
		PASS ;
		END
	ELSE BEGIN WARN("=","LOCAL declaration missing identifier"); IF THISTYPE NEQ TERQ THEN PASS END ;
	END UNTIL  NOT ITSCH(<,>) ;
PUBLIC STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;$"#
BEGIN comment, evaluates the "variable" in THISWD ;
OWN INTEGER ERR!EVALV ;
CASE TYP OF
BEGIN COMMENT BY TYPE ;
[0] BEGIN IF ON THEN WARN("=","Undefined Identifier " & THISWD) ; RETURN(VIRGIN) END ;
[GLOBALTYPE]	RETURN(STBL[IX]) ;
[LOCALTYPE]	RETURN(SSTK[IX]) ;
[INTERNTYPE]
    BEGIN "INTERNALVARIABLE"
    RETURN(CASE IX OF (
	COMMENT 0 ... LINES	;  CVS(ABS(LINESLEFT)),
	COMMENT 1 ... COLUMNS;  CVS(CASE STATUS+1 OF (
		COMMENT -1 ... no place area ;  0,
		COMMENT  0 ... unopened area ;  COLS-(IF LINESLEFT<0 THEN 1 ELSE 0),
		COMMENT  1 ... open area	;  COLSLEFT,
		COMMENT  2 ... closed area	;  0,
		COMMENT  3 ... dis-declared	;  0)		),
	COMMENT 2 ...  !	;  !,
	COMMENT 3 ... SPREAD ;  CVS(SPREADM),
	COMMENT 4 ... FILLING;  IF  NOT FILL THEN "0" ELSE IF ADJUST THEN "1" ELSE "-1",
	COMMENT 5 ... !SKIP! ;  CVS(SAIL!SKIP!),
	COMMENT 6 ... !SKIPL!;  CVS(LH(SAIL!SKIP!)),
	COMMENT 7 ... !SKIPR!;  CVS(RH(SAIL!SKIP!)),
	COMMENT 8 ... NULL	;  NULL,
	COMMENT 9 ...  ∞	;  CVS(INF),
	COMMENT 10... FOOTSEP;  FOOTSEP,
	COMMENT 11... TRUE	;  "-1",
	COMMENT 12... FALSE	;  "0",
	COMMENT 13... INDENT1;  CVS(FIRSTIM),
	COMMENT 14... INDENT2;  CVS(RESTIM),
	COMMENT 15... INDENT3;  CVS(RIGHTIM),
	COMMENT 16... LMARG	;  CVS(LMARG),
	COMMENT 17... RMARG	;  CVS(RMARG),
	COMMENT 18... CHAR	;  IF NOPGPH THEN "0" ELSE CVS(POSN), TES 0->"0" 5/26/74;
	COMMENT 19... CHARS	;  CVS(IF NOPGPH THEN RMARG-LMARG ELSE MAXIM-POSN),
	COMMENT 20... LINE	;  CVS(IF STATUS=1 THEN LINE ELSE 0),
	COMMENT 21... COLUMN	;  CVS(IF STATUS=1 THEN COL ELSE 0),
	COMMENT 22... TOPLINE;  CVS(LINE1(IF AREAIXM THEN AREAIXM ELSE IXTEXT)),
	COMMENT 23... XCRIBL;   CVS(XCRIBL),
	COMMENT 24... CHARW	;  CVS(CHARW),
	COMMENT 25... XGENLINES; CVS(XGENLINES),
	COMMENT 26... UNDERLINE ; VUNDERLINE, TES 10/22/73 ;
	COMMENT 27... THISDEVICE ; TES 11/15/73 ;
		CASE ABS(DEVICE)-1 OF ("LPT","TTY",
			IFCR PARCVER THENC PARCMNEMONIC ELSEC "MIC" ENDC,
			"XGP"),
	COMMENT 28... THISFONT ; IF THISFONT < 10 THEN
		THISFONT+"0" ELSE THISFONT+("A"-10),
	COMMENT 29... FOOTGAP ; CVS(FTGP), TES 11/27/73 ;
	COMMENT 30... FOOTSEPFONT ; PICKFONT(FSFONT)[3 FOR 1], TES 11/29/73 ;
	COMMENT 31... TTY	;  TYPEIN, TES 11/29/73 ;
	COMMENT 32... ODDLEFTBORDER ; CVS(ODDLEFTBORDER), TES 6/11/74 ;
	COMMENT 33... EVENLEFTBORDER ; CVS(EVENLEFTBORDER), TES 6/11/74 ;
	COMMENT 34... FULLFILE ; FULLFILE, TES 10/15/74 ;
	COMMENT 35... THISLINE ; OWL[1 TO OAKS], TES 8/19/74 ;
	COMMENT 36... MAXTEMPLATE ; CVS(MAXTEMPLATE), TES 8/19/74 ;
	COMMENT 37... ERRLF ; CVS(ERRLF), TES 8/21/74 ;
	COMMENT 38... DEBUGFLAG ; CVS(DEBUGFLAG), TES 8/21/74 ;
	COMMENT 39... VBPI ; CVS(VBPI), TES 8/24/74 ;
	COMMENT 40... HBPI ; CVS(HBPI), TES 8/24/74 ;
	COMMENT 41... !XGPLFTMAR ; CVS((ODDLEFTBORDER*HBPI)/1000), TES 9/4/74 ;
	COMMENT 42... MINCHARW ; CVS(MINCHARW), TES 9/26/74 ;
	COMMENT 43... FOOTGAP2 ; CVS(FTGP2), TES 11/2/74 ;
	COMMENT 44... MILLSPACING ; CVS(MSPREADM), TES 11/2/74 ;
	COMMENT 45... MILLPREFACE ; CVS(IF NOFILL THEN MLEADNM ELSE MLEADFM), TES 11/2/74 ;
	COMMENT 46... LINEPREFACE ; CVS(IF NOFILL THEN LEADNM ELSE LEADFM), TES 11/2/74 ;
	COMMENT 47... LINESPACING ; CVS(SPREADM-1), TES 11/2/74 ;
	COMMENT 48... !XGPINTRA ; TES 11/2/74 ;
		CVS(((IF MILLVERTI<0 THEN MILLVERTIDEFAULT ELSE MILLVERTI)*VBPI)/1000),
	COMMENT 32... TOPBORDER ; CVS(TOPBORDER), TES 1/26/75 ;
	COMMENT 33... BOTTOMBORDER ; CVS(BOTTOMBORDER), TES 1/26/75 ;
	COMMENT 34... AUTOCRLF ; CVS(AUTOCRLF), RKJ: 6-FEB-75;
	COMMENT 35... CHARH ; (IF XCRIBL THEN CVS(CHARH) ELSE "1"), RKJ: 6-Feb-75 ;
	WARNN(ERR!EVALV,NULL,"PUB Bug: EVALV CASE number too high")
	)	)  ;
    END "INTERNALVARIABLE" ;
[CMDTYPE]	WARN("=",THISWD&" in an expression") ;
[PORTYPE]	RETURN(THISWD) ;
[PCOUNTERTYPE]	RETURN(PATT!VAL(PATT!STRS(IX))) ;
[AREATYPE]	RETURN(THISWD) ;
[COUNTERTYPE]	RETURN(CTR!VAL(PATT!STRS(IX)))
END COMMENT BY TYPE ; ;
RETURN(NULL) ;
END "EVALV" ;
PUBLIC STRING SIMPLE PROCEDURE VASSIGN(INTEGER VSYMB, VTYPE, VIX; STRING VAL) ;$"#
BEGIN "VASSIGN" comment, NAME←VAL ;
SIMPLE PROCEDURE RDONLY(STRING IV) ; WARN("=","The value of "&IV&" is read-only") ;
IF ON THEN CASE VTYPE OF
BEGIN COMMENT BY TYPE ;
[0]		BIND(VSYMB←DECLARE(VSYMB, GLOBALTYPE), PUTS(VAL)) ; COMMENT Undeclared identifier ;
[GLOBALTYPE]	STBL[VIX] ← VAL ;
[LOCALTYPE]	SSTK[VIX] ← VAL ;
[INTERNTYPE]	CASE VIX OF
	BEGIN COMMENT INTERNAL ;
	COMMENT 0 ... LINES	;  RDONLY("LINES") ;
	COMMENT 1 ... COLUMNS;  RDONLY("COLUMNS") ;
	COMMENT 2 ...  !	;  ! ← VAL ;
	COMMENT 3 ... SPREAD ;  SPREADM ← CVD(VAL) ;
	COMMENT 4 ... FILLING;  RDONLY("FILLING") ;
	COMMENT 5 ... !SKIP! ;  SAIL!SKIP! ← CVD(VAL) ;
	COMMENT 6 ... !SKIPL!;  DPB(CVD(VAL), H1(SAIL!SKIP!)) ;
	COMMENT 7 ... !SKIPR!;  DPB(CVD(VAL), H2(SAIL!SKIP!)) ;
	COMMENT 8 ... NULL	;  RDONLY("NULL") ;
	COMMENT 9 ...  ∞	;  RDONLY("∞") ;
	COMMENT 10... FOOTSEP;  FOOTSEP ← VAL ;
	COMMENT 11... TRUE	;  RDONLY("TRUE") ;
	COMMENT 12... FALSE	;  RDONLY("FALSE") ;
	COMMENT 13... INDENT1;  FIRSTIM ← CVD(VAL) ;
	COMMENT 14... INDENT2;  RESTIM ← CVD(VAL) ;
	COMMENT 15... INDENT3;  BEGIN RIGHTIM ← CVD(VAL) ; COMPMAXIMS END ;
	COMMENT 16... LMARG	;  BEGIN LMARG ← CVD(VAL) MAX 0 MIN
		COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT)-1 ; COMPMAXIMS END ;
	COMMENT 17... RMARG	;  BEGIN RMARG ← CVD(VAL) MAX 1 MIN
		COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT) ; COMPMAXIMS END ;
	COMMENT 18... CHAR	;  RDONLY("CHAR") ;
	COMMENT 19... CHARS	;  RDONLY("CHARS") ;
	COMMENT 20... LINE	;  RDONLY("LINE") ;
	COMMENT 21... COLUMN	;  RDONLY("COLUMN") ;
	COMMENT 22... TOPLINE;  RDONLY("TOPLINE") ;
	COMMENT 23... XCRIBL	;  RDONLY("XCRIBL") ;
	COMMENT 24... CHARW	;  IF XCRIBL THEN CHARW ← CVD(VAL) ELSE
		WARN ("=","DEVICE XGP must precede assignment to CHARW.");
		BH 3/12/75;
	COMMENT 25... XGENLINES; XGENLINES ← CVD(VAL) ;
	COMMENT 26... UNDERLINE ;	VUNDERLINE ← VAL ; TES 10/22/73 ;
	COMMENT 27... THISDEVICE ; RDONLY("DEVICE") ; TES 11/15/73
	COMMENT 28... THISFONT ; RDONLY("THISFONT") ; TES 11/15/73 ;
	COMMENT 29... FOOTGAP ; FTGP ← CVD(VAL) ; TES 11/29/73 ;
	COMMENT 30... FOOTSEPFONT ; FSFONT ← RFONT(VAL) ; TES 11/29/73 ;
	COMMENT 31... TTY ;	BEGIN
			IF (NOT SWDBACK) AND AUTOCRLF THEN OUTSTR(CRLF) ;
			OUTSTR(VAL) ;
			IF AUTOCRLF THEN
			    BEGIN OUTSTR(CRLF); SWDBACK ← TRUE END ;
			END ; TES 11/29/73 AND 4/11/74 ; RKJ: 6-FEB-75;
	COMMENT 32... ODDLEFTBORDER ; ODDLEFTBORDER ← CVD(VAL) ; TES 6/11/74 ;
	COMMENT 33... EVENLEFTBORDER ; EVENLEFTBORDER ← CVD(VAL) ; TES 6/11/74 ;
	COMMENT 34... FULLFILE ; RDONLY("FULLFILE") ; TES 6/13/74;
	COMMENT 35... THISLINE ; RDONLY("THISLINE") ; TES 8/19/74 ;
	COMMENT 36... MAXTEMPLATE ; MAXTEMPLATE ← CVD(VAL) ; TES 8/19/74 ;
	COMMENT 37... ERRLF ; ERRLF ← CVD(VAL) ; TES 8/20/74 ;
	COMMENT 38... DEBUGFLAG ; DEBUGFLAG ← CVD(VAL) ; TES 8/21/74 ;
	COMMENT 39... VBPI ; VBPI ← CVD(VAL) ; TES 8/24/74 ;
	COMMENT 40... HBPI ; HBPI ← CVD(VAL) ; TES 8/24/74 ;
	COMMENT 41... !XGPLFTMAR ;
			BEGIN
			OUTSTR("   !XGPLFTMAR->ODD/EVENLEFTBORDER   ") ;
			ODDLEFTBORDER ← EVENLEFTBORDER ← (CVD(VAL)*1000)/HBPI ;
			END ;	TES 9/4/74 ;
	COMMENT 42... MINCHARW ; MINCHARW ← CVD(VAL); TES 9/26/74 ;
	COMMENT 43... FOOTGAP2 ; FTGP2 ← CVD(VAL) ; TES 11/2/74 ;
	COMMENT 44... MILLSPACING ; MSPREADM ← CVD(VAL) ; TES 11/2/74 ;
	COMMENT 45... MILLPREFACE ;
		IF NOFILL THEN MLEADNM←CVD(VAL)
		ELSE MLEADFM ← CVD(VAL) ; TES 11/2/74 ;
	COMMENT 46... LINEPREFACE ;
		IF NOFILL THEN LEADNM←CVD(VAL)
		ELSE LEADFM ← CVD(VAL) ; TES 11/2/74 ;
	COMMENT 47... LINESPACING ; SPREADM ← CVD(VAL)+1 ; TES 11/2/74 ;
	COMMENT 48... !XGPINTRA ; TES 11/2/74 ;
		IF MILLVERTI GEQ 0 THEN
		WARN(NULL,<"Too late to set !XGPINTRA" & CRLF &
			"Better to use SPACING n MILLS anyway">)
		ELSE MILLVERTI ← (CVD(VAL)*1000)/VBPI ;
	COMMENT 32... TOPBORDER ; TOPBORDER ← CVD(VAL) ; TES 1/26/75 ;
	COMMENT 34... AUTOCRLF ; AUTOCRLF ← CVD(VAL) ; RKJ: 6-FEB-75;
	COMMENT 35... CHARH; RDONLY("CHARH") ; RKJ: 6-Feb-75 ;
	END ; COMMENT INTERNAL ;
[CMDTYPE]	WARN("Improper use of ←",<"← after reserved word "&SYM[VSYMB]&" -- assignment ignored">) ;
[PORTYPE]	WARN("=","← after PORTION name "&SYM[VSYMB]) ;
[PCOUNTERTYPE]	PATT!VAL(PATT!STRS(VIX)) ← VAL ;
[AREATYPE]	WARN("=","← after Area name "&SYM[VSYMB]) ;
[COUNTERTYPE]	CTR!VAL(PATT!STRS(VIX)) ← VAL
END ; COMMENT BY TYPE ;
RETURN(VAL) ;
END "VASSIGN" ;
PUBLIC STRING SIMPLE PROCEDURE VEVAL ;$"#
	RETURN(EVALV(THISWD, IX, THISTYPE)) ;
FINISHED

ENDOF("VARBL")